CU Amiga Super CD-ROM 14/CU Amiga Magazine's Super CD-ROM 14 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-09].iso/CUCD/Online/News/Thor/rexx/SortMail.br

Text File | 1996-11-11 | 57.3 KB | 1,833 lines

/*
** $VER: SortMail.br 3.34 (27.10.96)
** by Eirik Nicolai Synnes
**
** Some code borrowed from AddSOUP.thor     by Magne Østlyngen
**                     and AddAmiNetList.br by Petter Nilsen
**
** See SortMail.guide for documentation
**
*/

options results
options failat 31

/*signal on error*/
signal on syntax
signal on break_c
signal on halt

parse arg arguments

/*
** Initialize some variables
*/

version         = subword(sourceline(2), 4)

cfgfile         = 'SortMail.cfg'

template        = 'SYSTEM/A,MSGNO/K/N/M,SHANGHAI/S,LOGINSTATE/S,NOWARN/S,NOCOUNTER/S,ALL/S,QUIET/S'

args.all        = 0; args.quiet      = 0; args.shanghai    = 0;
args.loginstate = 0; args.nowarn     = 0; args.nocounter   = 0;

fromthor        = 0; delnewfiles     = 0
logcount        = 0; aminetlogcount  = 0; errlogcount      = 0

BDB_ADD_USERS           =  9  /* Parser should add users to database. */

MDB_READ                =  1  /* Message is read. */
MDB_DELETED             =  5  /* Message is deleted. */
MDB_MARKED              = 10  /* Message is marked. */
MDB_SUPERMARKED         = 13  /* Message will not be unmarked as long as this flag is set. */

UDB_DELETED             =  0  /* User is deleted */
UDB_UNRECOVERABLE       =  1  /* User can not be undeleted */

globals = 'sigl thorport ver. fromthor progwin thorpath cfgfile log. logcount delnewfiles aminetlog. aminetlogcount errlog. errlogcount counter data. head. text. textread globalcfg. args. trigger. newmsg. bbsdata. conflist. cursys. fileopen BBSREAD.LASTERROR THOR.LASTERROR globals'

/* See if I'm run from Thor */

if left(address(), 5) = 'THOR.' then do
    thorport = address()

    address(thorport)
    'GETGLOBALCONFIG STEM 'globcfg
    if rc ~= 0 then call displayerror(30, 'SortMail', 'GETGLOBALCONFIG: 'THOR.LASTERROR)

    pubscreen = globcfg.PUBSCREENNAME
    fromthor = 1
    end

/* Find/open BBSREAD ARexx port */

if ~show('P', 'BBSREAD') then do
    address(command)
    'Run >NIL: `GetEnv THOR/THORPath`bin/LoadBBSRead'
    'WaitForPort BBSREAD'
    if rc ~= 0 then displayerror(30, 'SortMail', 'Couldn''t open BBSREAD''s ARexx port.')
    end

/*
** Give template if arguments = '?'
*/

if arguments = '?' then do
    say 'Usage: 'template
    signal cleanup
    end

/*
** See if another copy of SortMail is already running
*/

if getclip('SM_Active') ~= '' then call notify("Another copy of SortMail is probably running.\nDo you want to continue?", "Yes|No")
if result = 0 then exit(0)
call setclip('SM_Active', 'True')

/*
** See if user has entered a system or is in the startup window
*/

if fromthor then do
    address(thorport)
    'CURRENTSYSTEM STEM 'cursys
    if rc = 1 then do
        call displayerror(30, 'SortMail', 'Enter a system before running this script.')
        end
    else if rc > 1 then call displayerror(30, 'SortMail', 'CURRENTSYSTEM: 'THOR.LASTERROR)

    address(bbsread)
    'GETBBSDATA "'cursys.BBSNAME'" 'bbsdata
    if rc ~= 0 then call displayerror(30, 'SortMail', 'GETBBSDATA: 'BBSREAD.LASTERROR)
    end
else do
    address(bbsread)
    'READARGS "'template'" 'args' CMDLINE 'arguments
    if rc ~= 0 then do
        say BBSREAD.LASTERROR
        say 'Template: 'template
        signal cleanup
        end

    /* Check validity of command line arguments */
    if args.SHANGHAI & symbol('args.MSGNO.COUNT') = 'VAR' then call displayerror(30, 'SortMail', 'You can''t specify both SHANGHAI/S and MSGNO/K/N at the same time.')
    if args.LOGINSTATE & ~args.SHANGHAI then call displayerror(30, 'SortMail', 'LOGINSTATE/S can only be used together with SHANGHAI/S.')

    globalcfg.SYSTEM = args.SYSTEM

    address(bbsread)
    'GETBBSDATA "'globalcfg.SYSTEM'" 'bbsdata
    if rc ~= 0 then call displayerror(30, 'SortMail', 'GETBBSDATA: 'BBSREAD.LASTERROR)
    end

/*
** Find the configuration file
*/

if ~exists(bbsdata.BBSPATH || cfgfile) then call displayerror(30, 'SortMail', 'Couldn''t find configuration file ('bbsdata.BBSPATH || cfgfile').')

/*
** Display some progress info
*/

if fromthor then do
    address(thorport)
    'OPENPROGRESS TITLE "SortMail.br 'version'" PT "Reading configuration..." AT "_Abort" PCW 40'
    if rc = 0 then progwin = result
    else call displayerror(30, 'SortMail', 'OPENPROGRESS: 'THOR.LASTERROR)
    end
else if ~args.QUIET then do
    say 'SortMail 'version' by Eirik Nicolai Synnes'
    say 'Reading configuration...'
  end

/*
** Read configuration
*/

call readcfg()

if args.NOWARN then globalcfg.NOWARN = 1

/*
** Get some system info
*/

if ~fromthor then do
    'GETCONFDATA "'globalcfg.SYSTEM'" "'globalcfg.conference'" STEM 'confdata
    if rc ~= 0 then call displayerror(30, 'SortMail', 'GETCONFDATA: 'BBSREAD.LASTERROR)
    end

/*
** Exit if there's no marked messages in email conference
*/

if args.LOGINSTATE & confdata.MSGMARKED = 0 then signal cleanup

/*
** Get a list of the messages to process
*/

if fromthor then do
    /* Get message array from Thor */

    if globalcfg.LOGINSTATE then lstate = 'LOGINSTATE'
    else lstate = ''
    address(thorport)
    'GETMESSAGEARRAY "'globalcfg.conference'" 'msgs' 'lstate
    if rc = 5 then signal cleanup
    else if rc ~= 0 then call displayerror(30, 'SortMail', 'GETMESSAGEARRAY: 'THOR.LASTERROR)
    end
else do
    select
        when symbol('args.MSGNO.COUNT') = 'VAR' then do
            /* Create message array from msg number given on cmd line */

            argcnt = 0
            do i = 1 to args.MSGNO.COUNT
                if (args.MSGNO.i > confdata.FIRSTMSG - 1) & (args.MSGNO.i < confdata.LASTMSG + 1) then do
                    argcnt = argcnt + 1
                    msgs.argcnt = args.MSGNO.i
                    end
                end

            msgs.count = argcnt
            args.ALL = 1
            end

        when args.SHANGHAI then do
            /* Get message array from an available Thor port */

            ports = show('P')
            do i = 1 to words(ports)
                if pos(' THOR.', ports) > 0 then thorport = word(substr(ports, pos(' THOR.', ports)), 1)
                end

            if thorport ~= 'THORPORT' then do
                if args.LOGINSTATE then lstate = 'LOGINSTATE'; else lstate = ''

                call getver()
                address(thorport)

                if (ver.thorver > 2) | ((ver.thorver = 2) & (ver.thorrev > 31)) then do
                    'GETMESSAGEARRAY CONFNAME "'globalcfg.conference'" SYSTEM "'globalcfg.system'" STEM 'msgs lstate
                    if rc = 5 then signal cleanup
                    else if rc ~= 0 then call displayerror(30, 'SortMail', 'GETMESSAGEARRAY: 'THOR.LASTERROR)
                    end
                else do
                    'CURRENTSYSTEM STEM 'cursys
                    if rc > 1 then displayerror(rc, 'SortMail', 'CURRENTSYSTEM: 'THOR.LASTERROR)
                    else if rc = 0 then do
                        if cursys.BBSNAME = globalcfg.SYSTEM then do
                            'GETMESSAGEARRAY CONFNAME "'globalcfg.conference'" STEM 'msgs lstate
                            if rc = 5 then signal cleanup
                            else if rc ~= 0 then call displayerror(30, 'SortMail', 'GETMESSAGEARRAY: 'THOR.LASTERROR)
                            end
                        end
                    end
                args.ALL = 1
                end
            else displayerror(30, 'SortMail', 'Couldn''t find Thor''s ARexx port.')
            end

        otherwise nop
        end
    end

if symbol('msgs.count') ~= 'VAR' then do
    /* Just do 'em all */

    if ~args.NOCOUNTER & exists(bbsdata.BBSPATH || 'SortMail.count') then do
        call open(cn, bbsdata.BBSPATH || 'SortMail.count', 'R')
        counter = readln(cn)
        call close(cn)
        if counter > confdata.FIRSTMSG then confdata.FIRSTMSG = counter
        if counter >= confdata.LASTMSG then signal cleanup
        end

    msgs.count = confdata.LASTMSG - confdata.FIRSTMSG + 1

    if msgs.count > 0 then do i = 1 to (confdata.LASTMSG - confdata.FIRSTMSG) + 1
        msgs.i = confdata.FIRSTMSG + (i - 1)
        end
    end

/*
** Exit if there are no messages to process
*/

if msgs.count = 0 then signal cleanup

/*
** Set ARexx clips
*/

call setclip('SM_System', globalcfg.SYSTEM)
call setclip('SM_Conference', globalcfg.CONFERENCE)
if fromthor then setclip('SM_ThorPort', thorport)

/*
** Utilize BBSRead's copyback buffer
*/

address(bbsread)
'BUFMODE COPYBACK'

/*
** Start processing messages
*/

processed = 0; totfound = 0; totfail = 0

do i = 1 to msgs.count
    msgfini = 0; textread = 0; failed = 0; dodelmsg = 0; dodeluser = 0
    drop data. head. text.

    /* Update progressreport */
    if fromthor then do
        progtext = 'Processing message 'i' of 'msgs.count' (#'msgs.i')'
        address(thorport)
        'UPDATEPROGRESS REQ 'progwin' TOTAL 'msgs.count' CURRENT 'i' PT "'progtext'"'
        if rc = 5 then signal writelog
        else if rc > 0 then call displayerror(rc, 'SortMail', 'UPDATEPROGRESS: 'THOR.LASTERROR, msgs.i)
        end
    else if (~args.QUIET) then do
        say '1B'x'[1A' || '1B'x'[K' || 'Message 'msgs.i' ('i' of 'msgs.count')' || '1B'x'[0m'
        say '1B'x'[1A' || '1B'x'[32CType: '
        end

    processed = processed + 1

    /* Read message data */
    address(bbsread)
    'READBRMESSAGE "'globalcfg.SYSTEM'" "'globalcfg.conference'" 'msgs.i' DATASTEM 'data
    if rc ~= 0 then do
        call displayerror(10, 'SortMail', 'READBRMESSAGE, data stem: 'BBSREAD.LASTERROR, msgs.i)
        iterate i
        end

    counter = msgs.i

    /* If messsage is marked as deleted or superunread then skip it */
    if ~fromthor & ~bittst(data.FLAGS, MDB_MARKED) & ~args.all then msgfini = 1
    if bittst(data.FLAGS, MDB_SUPERMARKED) then msgfini = 1
    if bittst(data.FLAGS, MDB_DELETED)     then msgfini = 1
    if msgfini = 1 then iterate i

    'READBRMESSAGE "'globalcfg.SYSTEM'" "'globalcfg.conference'" 'msgs.i' HEADSTEM 'head
    if rc ~= 0 then do
        call displayerror(10, 'SortMail', 'READBRMESSAGE, head stem: 'BBSREAD.LASTERROR, msgs.i)
        iterate i
        end

    /* Trigger loop */
    address(bbsread)
    do j = 1 to trigger.count
        foundmsg = 0; foundcrits = 0

        /* Search loop */
        do k = 1 to trigger.j.search.count while foundmsg = 0
            /* Search in names, addresses and subject */
            select
                when trigger.j.search.k.type = 'FROMADDR' then if index(upper(head.FROMADDR), upper(trigger.j.search.k.criteria)) > 0 then foundmsg = 1
                when trigger.j.search.k.type = 'FROMNAME' then if index(upper(head.FROMNAME), upper(trigger.j.search.k.criteria)) > 0 then foundmsg = 1
                when trigger.j.search.k.type = 'TOADDR'   then if index(upper(head.TOADDR),   upper(trigger.j.search.k.criteria)) > 0 then foundmsg = 1
                when trigger.j.search.k.type = 'TONAME'   then if index(upper(head.TONAME),   upper(trigger.j.search.k.criteria)) > 0 then foundmsg = 1
                when trigger.j.search.k.type = 'SUBJECT'  then if index(upper(head.SUBJECT),  upper(trigger.j.search.k.criteria)) > 0 then foundmsg = 1
                otherwise if trigger.j.search.k.type ~= 'HEADER' then do
                    if symbol('trigger.j.search.k.type') = 'VAR' then call displayerror(5, 'SortMail', 'Unsupported SEARCH type: 'trigger.j.search.type, msgs.i)
                    else call displayerror(5, 'SortMail', 'Trigger contains invalid search entry', msgs.i)
                    end
                end
            if trigger.j.matchall & foundmsg then do; foundcrits = foundcrits + 1; foundmsg = 0; end
            end

        do k = 1 to trigger.j.search.count while foundmsg = 0
            /* Search in header */
            if trigger.j.search.k.type = 'HEADER' then do
                if textread = 0 then do
                    'READBRMESSAGE "'globalcfg.SYSTEM'" "'globalcfg.conference'" 'msgs.i' TEXTSTEM 'text
                    if rc ~= 0 then do
                        call displayerror(10, 'SortMail', 'READBRMESSAGE, text stem: 'BBSREAD.LASTERROR, msgs.i)
                        iterate i
                        end
                    textread = 1
                    end
                if symbol('text.COMMENT.COUNT') = 'VAR' & text.COMMENT.COUNT > 0 then do l = 1 to text.COMMENT.COUNT
                    if upper(left(text.COMMENT.l, length(trigger.j.search.k.keyword))) = upper(trigger.j.search.k.keyword) & index(upper(text.COMMENT.l), upper(trigger.j.search.k.criteria)) > 0 then foundmsg = 1
                    end
                end
            if trigger.j.matchall & foundmsg then do; foundcrits = foundcrits + 1; foundmsg = 0; end
            end

        if trigger.j.matchall & foundcrits = trigger.j.search.count then foundmsg = 1

        if foundmsg = 0 then iterate j

        totfound = totfound + 1

        if ~fromthor & ~args.QUIET then do
            say '1B'x'[1A' || '1B'x'[K' || 'Message 'msgs.i' ('i' of 'msgs.count')' || '1B'x'[0m'
            say '1B'x'[1A' || '1B'x'[32CType: 'trigger.j.name
            end

        trigger.j.hitcount = trigger.j.hitcount + 1

        /* Set ARexx msgno clip */

        call setclip('SM_MsgNo', msgs.i)

        /* Action loop */
        if trigger.j.action.count > 0 then do k = 1 to trigger.j.action.count while failed = 0
            /* Execute internal functions */
            returned = 0

            select
                when trigger.j.action.k.type = 'COPY' then do
                    call copymsg(globalcfg.SYSTEM, globalcfg.conference, msgs.i, trigger.j.action.k.destconf, trigger.j.action.k.replyaddr, trigger.j.action.k.destsys)
                    returned = result
                    trigger.j.action.k.hitcount = trigger.j.action.k.hitcount + 1
                    end

                when trigger.j.action.k.type = 'RECENT' then do
                    call parseaminet(globalcfg.SYSTEM, globalcfg.conference, msgs.i, trigger.j.action.k.checkdupes, trigger.j.action.k.dontadd, trigger.j.action.k.nostats)
                    returned = result
                    trigger.j.action.k.hitcount = trigger.j.action.k.hitcount + 1
                    end

                when trigger.j.action.k.type = 'SAVEMESSAGE' then do
                    if symbol('trigger.j.action.k.substitute') = 'VAR' then do; subst = trigger.j.action.k.substitute; with =  trigger.j.action.k.with; end
                    else do; subst = ''; with = ''; end

                    if symbol('trigger.j.action.k.directory') = 'VAR' then call savemessage(msgs.i, 1, trigger.j.action.k.directory, trigger.j.action.k.header, trigger.j.action.k.append, trigger.j.action.k.nobin, subst, with)
                    else call savemessage(msgs.i, 0, trigger.j.action.k.filename, trigger.j.action.k.header, trigger.j.action.k.append, trigger.j.action.k.nobin, subst, with)
                    returned = result
                    trigger.j.action.k.hitcount = trigger.j.action.k.hitcount + 1
                    drop subst with
                    end

                when trigger.j.action.k.type = 'SPLITDIGEST' then do
                    call splitdigest(msgs.i, trigger.j.action.k.destconf, trigger.j.action.k.replyaddr, trigger.j.action.k.destsys, globalcfg.conference)
                    returned = result
                    trigger.j.action.k.hitcount = trigger.j.action.k.hitcount + 1
                    end

                otherwise if trigger.j.action.k.type ~= 'EXTERNAL' then do
                    returned = 5
                    if symbol('trigger.j.action.type') = 'VAR' then call displayerror(returned, 'SortMail', 'Unsupported ACTION type: 'trigger.j.action.type, msgs.i)
                    else call displayerror(returned, 'SortMail', 'Trigger contains invalid action entry', msgs.i)
                    end
                end

            if returned ~= 0 then do
                trigger.j.failcount = trigger.j.failcount + 1; failed = 1; totfail = totfail + 1
                end
            else do
                if trigger.j.delmsg = 1 then dodelmsg = 1
                if trigger.j.deluser = 1 then dodeluser = 1
                end
            end

        if trigger.j.action.count > 0 then do k = 1 to trigger.j.action.count while failed = 0
            /* Execute external scripts */
            returned = 0
            if trigger.j.action.k.type = 'EXTERNAL' then do
                call runexternal(trigger.j.action.k.scriptname, trigger.j.action.k.scriptopts, msgs.i)
                returned = result
                trigger.j.action.k.hitcount = trigger.j.action.k.hitcount + 1

                if returned ~= 0 then do
                    trigger.j.failcount = trigger.j.failcount + 1; failed = 1; totfail = totfail + 1
                    end
                else do
                    if trigger.j.delmsg = 1 then dodelmsg = 1
                    if trigger.j.deluser = 1 then dodeluser = 1
                    end
                end
            end

        leave
        end

    /* Remove ARexx msgno clip */

    call setclip('SM_MsgNo')

    if failed ~= 0 then iterate i

    address(bbsread)

    /* Delete user? */
    if (dodeluser = 1) & (bittst(bbsdata.FLAGS, BDB_ADD_USERS)) then do
        drop suser.
        'SEARCHBRUSER BBSNAME "'globalcfg.SYSTEM'" STEM 'suser' SEARCH "'head.FROMADDR'" ADDRESS'
        if rc ~= 0 then call displayerror(10, 'SortMail', 'SEARCHBRUSER: 'BBSREAD.LASTERROR, msgs.i)
        if result > 0 then do n = 1 to suser.COUNT
            if suser.n.FOUNDINTAG = 1 then do
                drop duser. tuser.
                'READBRUSER BBSNAME "'globalcfg.SYSTEM'" USERNR 'suser.n.USERNR' DATASTEM 'duser' TAGSSTEM 'tuser
                if rc ~= 0 then call displayerror(10, 'SortMail', 'READBRUSER: 'BBSREAD.LASTERROR, msgs.i)
                if ~bittst(duser.FLAGS, UDB_DELETED) & (data.MSGDATE < duser.USERDATE + 2) & (data.MSGDATE > duser.USERDATE - 2) & (head.FROMNAME = tuser.NAME) then do
                    'WRITEBRUSER BBSNAME "'globalcfg.SYSTEM'" UPDATEUSERNR 'suser.n.USERNR' DELETEUSER'
                    if rc ~= 0 then call displayerror(30, 'SortMail', 'WRITEBRUSER: 'BBSREAD.LASTERROR, msgs.i)
                    end
                end
            end
        end

    /* Delete original message? */
    if dodelmsg = 1 then do
        'UPDATEBRMESSAGE "'globalcfg.SYSTEM'" "'globalcfg.conference'" 'msgs.i' SETDELETED'
        if rc ~= 0 then displayerror(30, 'SortMail', 'UPDATEBRMESSAGE: 'BBSREAD.LASTERROR, msgs.i)
        end
    end

signal writelog

/*
** Some error detection stuff
*/

error:
syntax:

select
    when symbol('BBSREAD.LASTERROR') = 'VAR' then displayerror(rc, 'SortMail', 'Line 'sigl' in SortMail.br: 'BBSREAD.LASTERROR)
    when symbol('THOR.LASTERROR') = 'VAR' then displayerror(rc, 'SortMail', 'Line 'sigl' in SortMail.br: 'THOR.LASTERROR)
    otherwise displayerror(rc, 'SortMail', 'Error 'rc' in line 'sigl': 'errortext(rc))
    end

/*
** Write log message
*/

writelog:

if fromthor then do
    address(thorport)
    'UPDATEPROGRESS REQ 'progwin' TOTAL 2 CURRENT 2 PT "Writing log message..."'
    if rc = 5 then signal cleanup
    if rc > 0 then call displayerror(rc, 'SortMail', 'UPDATEPROGRESS: 'THOR.LASTERROR)
    end
else say '1B'x'[1A' || '1B'x'[K' || 'Writing log...' || '1B'x'[0m'

if globalcfg.STATISTICS & totfound > 0 then do
    logcount = logcount + 1; log.TEXT.logcount = 'SortMail processed 'msgs.count' messages and was triggered 'totfound' times, giving 'totfail' warnings/errors.'
    logcount = logcount + 1; log.TEXT.logcount = ''
    logcount = logcount + 1; log.TEXT.logcount = '*Trigger* *name*                          *Hits*      *Fails*'
    do i = 1 to trigger.count
        if trigger.i.hitcount > 0 then do
            logcount = logcount + 1; log.TEXT.logcount = left(trigger.i.name, 39)' 'left(trigger.i.hitcount, 9)' 'trigger.i.failcount
            end
        end
    logcount = logcount + 1; log.TEXT.logcount = ''

    do i = 1 to trigger.count
        if symbol('trigger.i.log.count') = 'VAR' & trigger.i.log.count > 0 then do
            do j = 1 to trigger.i.log.count
                logcount = logcount + 1; log.TEXT.logcount = trigger.i.log.j
                end
            logcount = logcount + 1; log.TEXT.logcount = ''
            end
        end
    end

if aminetlogcount > 0 then do
    do i = 1 to aminetlogcount
        logcount = logcount + 1;  log.TEXT.logcount = aminetlog.TEXT.i
        end
    logcount = logcount + 1;  log.TEXT.logcount = ''
    end

if errlogcount > 0 then do
    logcount = logcount + 1; log.TEXT.logcount = '*Warnings* *and* *errors*'
    logcount = logcount + 1; log.TEXT.logcount = ''
    do i = 1 to errlogcount
        logcount = logcount + 1; log.TEXT.logcount = errlog.TEXT.i
        end
    end

if logcount ~= 0 then do
    log.fromname   = 'SortMail'
    log.toname     = bbsdata.USERNAME
    log.toaddr     = bbsdata.EMAILADDR
    log.subject    = 'SortMail results'
    log.text.count = logcount

    call writemessage('"'globalcfg.SYSTEM'"' '"'globalcfg.CONFERENCE'"' log)
    if result ~= 0 then do
        if bbsdata.DNLOADPATH = '' then do
            address(bbsread)
            'GETGLOBALDATA 'globaldata
            if rc = 0 then logpath = globaldata.DNLOADPATH
            end
        else logpath = bbsdata.DNLOADPATH

        if symbol('logpath') = 'VAR' then do
            if right(logpath, 1) ~= '/' & right(logpath, 1) ~= ':' then logpath = logpath'/'
            call notify('SortMail couldn''t write the log as a message.\nDo you want to save it to 'logpath'SortMail.log?', 'Yes|No')
            if result = 1 then do
                lfopen = open(lf, logpath'SortMail.log', 'W')
                if lfopen then do
                    dtg = date('E')' at 'time('N'); call writeln(lf, 'SortMail results on 'dtg'.'); call writeln(lf, '')
                    do i = 1 to log.text.count; call writeln(lf, log.text.i); end
                    call close(lf)
                    end
                else displayerror(30, 'SortMail', 'Couldn''t open 'logpath'SortMail.log for writing.')
                end
            end
        else displayerror(30, 'SortMail',' Couldn''t write log to file.')
        end
    drop log.
    end

break_c:
halt:
cleanup:

if exists('T:SortMail.result') then 'Delete T:SortMail.result QUIET'

/*
** Turn off copyback buffer
*/

address(bbsread)
'BUFMODE ENDCOPYBACK'

/*
** Update message counter
*/

if symbol('counter') = 'VAR' & symbol('args.MSGNO.COUNT') ~= 'VAR' & ~args.SHANGHAI then do
    cnopen = open(cn, bbsdata.BBSPATH || 'SortMail.count', 'W')
    if cnopen then do
        call writeln(cn, counter)
        call close(cn)
        end
    end

/*
** Close progressbar if open
*/

if (symbol('progwin') = 'VAR') & (progwin ~= 0)  then do
    address(thorport)
    'CLOSEPROGRESS REQ 'progwin
    progwin = 0

    if (symbol('totfound') = 'VAR') & (totfound > 0) then do
        'CURRENTSYSTEM STEM 'cursys
        if rc > 1 then call displayerror(30, 'SortMail', 'CURRENTSYSTEM: 'THOR.LASTERROR)
        if (upper(cursys.CONFNAME) = upper(globalcfg.CONFERENCE)) then 'SHOWCONFERENCE "'globalcfg.CONFERENCE'"'
        'UPDATECONFWINDOW'
        end
    end

/*
** Remove ARexx clips
*/

call setclip('SM_System')
call setclip('SM_Conference')
call setclip('SM_ThorPort')
call setclip('SM_MsgNo')
call setclip('SM_Active')

/*
** Have a nice day
*/

exit(0)


 /****************************************************************************
**************************** Run an external script ***************************
 ****************************************************************************/

runexternal: interpret 'procedure expose 'globals
             parse arg scriptname, scriptopts, msgno

scriptopts = substitute(scriptopts, "%s", '"'globalcfg.SYSTEM'"')
scriptopts = substitute(scriptopts, "%c", '"'globalcfg.conference'"')
scriptopts = substitute(scriptopts, "%n", msgno)
if fromthor then scriptopts = substitute(scriptopts, "%p", '"'thorport'"')
else scriptopts = substitute(scriptopts, "%p", '"NONE"')

if index(scriptname, ':') > 0 then scriptpath = scriptname
else scriptpath = thorpath || scriptname

address(command)
'rx >T:SortMail.result 'scriptpath' 'scriptopts
returned = rc

if returned > 0 then do
    resopen = open(rf, 'T:SortMail.result', 'R')
    if resopen then do
        res = readln(rf)
        if left(res, 20) = 'rx failed returncode' then do
            res2 = readln(rf)
            if res2 ~= '' then res = res2
            end
        call close(rf)
        end
    else res = 'Unknown error'

    call displayerror(returned, 'External script 'scriptpath, res, msgno)
    end

if exists('T:SortMail.result') then 'Delete T:SortMail.result QUIET'

return(returned)


 /****************************************************************************
************************* Parse AmiNet RECENT updates *************************
 ****************************************************************************/

parseaminet: interpret 'procedure expose 'globals
             parse arg system, conference, number, checkdupes, dontadd, nostats

curline = 1; res = 0

/*
** Compensate for a bug in bbsread on OS2.x systems
*/

if right(bbsdata.BBSPATH, 1) ~= ':' & right(bbsdata.BBSPATH, 1) ~= '/' then bbsdata.BBSPATH = bbsdata.BBSPATH'/'

/*
** Read message text if it isn't already read
*/

address(bbsread)
if textread = 0 then do
    'READBRMESSAGE "'system'" "'conference'" 'number' TEXTSTEM 'text
    if rc ~= 0 then do
        call displayerror(10, 'AmiNet RECENT parser', 'READBRMESSAGE, text stem: 'BBSREAD.LASTERROR, number)
        return(10)
        end
    textread = 1
    end

/*
** Exit if it doesn't start with "|" (then it's probably not a RECENT msg)
*/

if left(text.TEXT.curline, 1) ~= '|' then do
    call displayerror(5, 'AmiNet RECENT parser', 'Not a AmiNet RECENT message.', number)
    return(5)
    end

/*
** Read exclude file
*/

openexcl = open(ef, bbsdata.BBSPATH || 'SortMail.excl', 'R')
if openexcl then do
    cnt = 0
    do until eof(ef)
        entry = readln(ef)
        if entry ~= '' then do; cnt = cnt + 1; excldir.cnt = entry; end
        end
    excldir.count = cnt
    call close(ef)
    end

/*
** Skip all lines beginning with "|"
*/

do while(left(text.TEXT.curline, 1) = '|'); curline = curline + 1; end

/*
** Exit if there are no new files
*/

if curline >= text.TEXT.COUNT then do
    call displayerror(5, 'AmiNet RECENT parser', 'No new files in message.', number)
    return(5)
    end

/*
** Update NewFiles.txt, delete it first if there's a old one there already
*/

if (delnewfiles = 0) & (exists(bbsdata.BBSPATH'Newfiles.txt')) then do
    address(command)
    'Delete "'bbsdata.BBSPATH'Newfiles.txt" QUIET'
    delnewfiles = 1
    end

if exists(bbsdata.BBSPATH'Newfiles.txt') then call open(ar, bbsdata.BBSPATH'Newfiles.txt', 'A')
else call open(ar, bbsdata.BBSPATH'Newfiles.txt', 'W')

/*
** Process the RECENT message
*/

address(bbsread)

do until curline = text.TEXT.COUNT
    aline = text.TEXT.curline
    if left(aline, 1) = '|' then signal writestats
    if aline ~= "" then do
        delfile = 0; drop found. filetags.

        if (dontadd = 1) then addfile = 0; else addfile = 1

        if (aline) = 'Message of the day:' then signal writemotd

        farea = word(aline, 2)

        if (addfile) & (openexcl) then do i = 1 to excldir.count
            if (index(excldir.i, '/') > 0) & (farea = excldir.i) then addfile = 0
            else if left(farea, length(excldir.i)) = excldir.i then addfile = 0
            end

        if (addfile) then do
            fname = word(aline, 1)
            fdesc = right(aline, length(aline) - 35)

            fsize = right(left(aline, 34), 5)
            if right(fsize, 1) = 'M' then mega = 1
            else mega = 0
            fsize = compress(fsize, 'KM .')

            if ~datatype(fsize, 'W') then fsize = 0
            fsize = fsize * 1024
            if mega = 1 then fsize = trunc((fsize * 1024) / 10)

            if checkdupes then do
                'SEARCHBRFILE BBSNAME "'system'" FAREANAME "'farea'" SEARCH "'fname'" NAME STEM 'found
                if rc = 6 then drop BBSREAD.LASTERROR
                else if rc ~= 0 then do
                    res = rc
                    call displayerror(res, 'AmiNet RECENT parser', 'SEARCHBRFILE: 'BBSREAD.LASTERROR, number)
                    end
                else if result > 0 then do i = 1 to found.FILE.1.COUNT
                    'READBRFILE BBSNAME "'system'" FAREANAME "'farea'" FILENR 'found.FILE.1.i' TAGSSTEM 'filetags
                    if rc ~= 0 then  do
                        res = rc
                        call displayerror(res, 'AmiNet RECENT parser', 'READBRFILE: 'BBSREAD.LASTERROR, number)
                        end
                    else if filetags.DESCRIPTION.1 ~= fdesc & (fsize > filetags.SIZE + 1023 | fsize < filetags.SIZE - 1024) then do
                        'WRITEBRFILE BBSNAME "'system'" FAREANAME "'farea'" UPDATEFILENR 'found.FILE.1.1' DELETEFILE'
                        if rc ~= 0 then do
                            res = rc
                            call displayerror(res, 'AmiNet RECENT parser', 'WRITEBRFILE: 'BBSREAD.LASTERROR, number)
                            end
                        delfile = 1
                        end
                    if delfile = 0 then addfile = 0
                    end
                end
            end

        if addfile & fdesc ~= '' then do
            'CONFIGFAREA "'system'" "'farea'"'
            if rc ~= 0 then call displayerror(rc, 'AmiNet RECENT parser', 'CONFIGFAREA: 'BBSREAD.LASTERROR, number)

            drop brfile.
            brfile.NAME = fname
            brfile.SIZE = fsize
            brfile.DATE = head.CREATIONDATE
            brfile.DESCRIPTION.COUNT = 1
            brfile.DESCRIPTION.1 = strip(fdesc)

            'WRITEBRFILE "'system'" "'farea'" STEM 'brfile
            if rc ~= 0 then do
                call displayerror(rc, 'AmiNet RECENT parser', 'WRITEBRFILE: 'BBSREAD.LASTERROR, number)
                res = rc
                end
            end

        call writeln(ar, aline)
        end
    curline = curline + 1
    end

signal amifini

/*
** Write statistics from AmiNet
*/

writestats:

if nostats = 1 then signal amifini

aminetlogcount = aminetlogcount + 1; aminetlog.text.aminetlogcount = '*AmiNet* *Statistics*'
aminetlogcount = aminetlogcount + 1; aminetlog.text.aminetlogcount = ''

do i = curline to text.TEXT.COUNT
    aline = text.TEXT.i
    if aline = 'Message of the day:' then do
        curline = i
        signal writemotd
        end
    aminetlogcount = aminetlogcount + 1; aminetlog.text.aminetlogcount = aline
    end
aminetlogcount = aminetlogcount + 1; aminetlog.text.aminetlogcount = ''

signal amifini

/*
** Write AmiNet Message of the Day
*/

writemotd:

if nostats = 1 then signal amifini

address(bbsread)
'AMIGA2DATE SECONDS 'head.CREATIONDATE' STEM 'time
if rc ~= 0 then displayerror(5, 'AmiNet Message of the Day', BBSREAD.LASTERROR, number)

aminetlogcount = aminetlogcount + 1; aminetlog.text.aminetlogcount = '*AmiNet* *Message* *of* *the* *Day*: 'time.MDAY'.'time.MONTH'.'time.YEAR
aminetlogcount = aminetlogcount + 1; aminetlog.text.aminetlogcount = ''

do i = curline to text.TEXT.COUNT
    aline = text.TEXT.i
    if left(aline, 1) = '|' then do
        curline = i
        signal writestats
        end
    aminetlogcount = aminetlogcount + 1; aminetlog.text.aminetlogcount = aline
    end
aminetlogcount = aminetlogcount + 1; aminetlog.text.aminetlogcount = ''

/*
** Clean up and return
*/

amifini:
call close(ar)

return(res)


 /****************************************************************************
******************************** Copy messages ********************************
 *****************************************************************************/

copymsg: interpret 'procedure expose 'globals
         parse arg system, mailconf, number, toconf, repaddr, tosys

/*
** Read text stem if it's not already read
*/

address(bbsread)
if textread = 0 then do
    'READBRMESSAGE "'system'" "'mailconf'" 'number' TEXTSTEM 'text
    if rc ~= 0 then do
        call displayerror(10, 'Message copy', BBSREAD.LASTERROR, number)
        return(10)
        end
    textread = 1
    end

if text.TEXT.COUNT = 0 & (text.PART.COUNT = 0 | symbol('text.PART.COUNT') ~= 'VAR') then do
    text.TEXT.1 = ' '; text.TEXT.COUNT = 1
    end

if head.fromname        ~= "HEAD.FROMNAME"        then text.fromname        = head.fromname
if head.fromaddr        ~= "HEAD.FROMADDR"        then text.fromaddr        = head.fromaddr
if head.toname          ~= "HEAD.TONAME"          then text.toname          = head.toname
if head.toaddr          ~= "HEAD.TOADDR"          then text.toaddr          = head.toaddr
if head.msgid           ~= "HEAD.MSGID"           then text.msgid           = head.msgid
if head.refid           ~= "HEAD.REFID"           then text.refid           = head.refid
if head.creationdate    ~= "HEAD.CREATIONDATE"    then text.creationdate    = head.creationdate
if head.creationdatetxt ~= "HEAD.CREATIONDATETXT" then text.creationdatetxt = head.creationdatetxt
if head.subject         ~= "HEAD.SUBJECT"         then text.subject         = head.subject

text.replyconf = mailconf

drop text.replyname
if (repaddr = '') | (right(repaddr, 9) = 'REPLYADDR') then do
    if symbol('text.replyaddr') ~= 'VAR' then do
        text.replyaddr = head.fromaddr
        if symbol('head.fromname') = 'VAR' then text.replyname = head.fromname
        end
    end
else text.replyaddr = repaddr

repl = ""; priv = ""; kep = ""; urg = ""; imp = ""; conf = ""
if bittst(data.flags,  1) then repl = "REPLIED"
if bittst(data.flags,  2) then priv = "PRIVATE"
if bittst(data.flags,  7) then kep  = "KEEP"
if bittst(data.flags, 11) then urg  = "URGENT"
if bittst(data.flags, 12) then imp  = "IMPORTANT"
if bittst(data.flags, 17) then conf = "CONFIDENTIAL"

if (tosys = '') | (right(tosys, 7) = 'DESTSYS') then call writemessage('"'system'"' '"'toconf'"' text repl priv kep urg imp conf HAZELEVEL data.HAZELEVEL)
else call writemessage('"'tosys'"' '"'toconf'"' text repl priv kep urg imp conf HAZELEVEL data.HAZELEVEL)

return(result)


 /****************************************************************************
***************************** Save message to disk ****************************
 ****************************************************************************/

savemessage: interpret 'procedure expose 'globals
             parse arg msgno, desttype, destname, header, append, nobin, subst, with

/*
** Find download path
*/

address(bbsread)
if symbol('bbsdata.DNLOADPATH') ~= 'VAR' | bbsdata.DNLOADPATH = '' then do
    'GETGLOBALDATA 'globaldata
    if rc ~= 0 then do
        call displayerror(returned, 'Save message', 'GETGLOBALDATA: 'BBSREAD.LASTERROR, msgno)
        return(returned)
        end
    downloadpath = globaldata.DNLOADPATH
    end
else downloadpath = bbsdata.DNLOADPATH

if right(downloadpath, 1) ~= ':' & right(downloadpath, 1) ~= '/' then downloadpath = downloadpath'/'

/*
** Find path, filename and mode of output file
*/

select
    when desttype = 0 then do
        destfile = destname
        if (append) & (exists(fileame)) then filemode = 'A'
        else filemode = 'W'
        end

    when desttype = 1 then do
        destfile = head.SUBJECT

        if subst ~= '' then do
            if with ~= '' then destfile = substitute(destfile, subst, with)
            else do
                call displayerror(20, 'Save message', 'SUBSTITUTE/K needs WITH/K.', msgno)
                return(20)
                end
            end

        /* Strip unwanted characters and "Re: " from subject */
        destfile = compress(destfile, '*')
        destfile = compress(destfile, '#')
        destfile = compress(destfile, '?')
        destfile = compress(destfile, '`')
        destfile = compress(destfile, '/')
        destfile = compress(destfile, ':')
        do while upper(left(destfile, 3)) = 'RE '
            if upper(left(destfile, 3)) = 'RE ' then destfile = substr(destfile, 4)
            end

        if right(destname, 1) ~= ':' & right(destname, 1) ~= '/' then destname = destname'/'

        destfile = destname || destfile

        if (append) & (exists(destfile)) then filemode = 'A'
        else filemode = 'W'
        end

    otherwise do
        call displayerror(20, 'Save Message', 'Neither DIRECTORY/K nor FILENAME/K were specified.', msgno)
        return(20)
        end
    end

fileopen = 0

if symbol('thorport') = 'VAR' & thorport ~= 'NONE' then do
    if ~nobin then do
        address(bbsread)
        if ~textread then do
            'READBRMESSAGE "'globalcfg.SYSTEM'" "'globalcfg.CONFERENCE'" 'msgno' TEXTSTEM 'text
            returned = rc
            if rc > 0 then do
                call displayerror(returned, 'Save message', 'READBRMESSAGE: 'BBSREAD.LASTERROR, msgno)
                return(returned)
                end
            textread = 1
            end
        call checkbin('text', msgno, downloadpath)
        returned = result
        end

    saveargs = ''
    if ~header then saveargs = saveargs' NOHEADER'
    if ~append then saveargs = saveargs' OVERWRITE'

    address(thorport)
    'SAVEMESSAGE "'globalcfg.SYSTEM'" "'globalcfg.CONFERENCE'" MSGNR 'msgno' FILE "'destfile'" 'saveargs
    smreturned = rc
    if rc ~= 0 then do
        call displayerror(smreturned, 'Save Message', 'SAVEMESSAGE: 'THOR.LASTERROR, msgno)
        end
    if symbol('returned') ~= 'VAR' then returned = 0
    if smreturned > returned then returned = smreturned; drop smreturned
    end
else do
    if textread = 0 then do
        address(bbsread)
        'READBRMESSAGE "'globalcfg.SYSTEM'" "'globalcfg.CONFERENCE'" 'msgno' TEXTSTEM 'text
        returned = rc
        if rc > 0 then do
            call displayerror(returned, 'Save message', 'READBRMESSAGE: 'BBSREAD.LASTERROR, msgno)
            return(returned)
            end
        textread = 1
        end

    call savemsg('head', 'text', destfile, filemode, header, nobin, msgno, downloadpath)
    returned = rc
    end

if fileopen then do
    call close(of)
    fileopen = 0
    end

return(returned)


 /****************************************************************************
******************* Check if a message contains binary parts ******************
 ****************************************************************************/

checkbin: interpret 'procedure expose 'globals
          parse arg tstem, msgno, downloadpath

/*
** Check for message parts
*/

if symbol(tstem'.PART.COUNT') = 'VAR' then do
    parts = value(tstem'.PART.COUNT')
    if parts > 0 then do i = 1 to parts
        select
         when symbol(tstem'.PART.'i'.BINARY') = 'VAR' then do
                if exists(value(tstem'.PART.'i'.BINARY')) then do
                    address(command)
                    'Copy "'value(tstem'.PART.'i'.BINARY')'" TO "'downloadpath'" CLONE QUIET'
                    if rc ~= 0 then do
                        call displayerror(20, 'Save message', 'Failed to copy binary part to download directory.', msgno)
                        return(20)
                        end
                    address(bbsread)
                    end
                end

            otherwise do
                usestem = tstem'.PART.'i'.MSG'
                call checkbin(usestem, msgno, downloadpath)
                end
            end
        end
    end

return(0)


 /****************************************************************************
*************** Recursive procedure for writing message to file ***************
 ****************************************************************************/

savemsg: interpret 'procedure expose 'globals
         parse arg hstem, tstem, filename, filemode, header, nobin, msgno, downloadpath

/*
** Open file for writing/appending
*/

if ~fileopen then do
    fileopen = open(of, filename, filemode)
    if fileopen & filemode = 'A' then call writeln(of, copies('=', 79))
    end

if ~fileopen then do
    call displayerror(20, 'Save Message', 'Couldn''t open "'filename'" for writing.', msgno)
    return(20)
    end

/*
** Write to/from names/addresses, subject and header
*/

if header then do
    if symbol(hstem.'FROMNAME') = 'VAR' then do
        from = value(hstem'.FROMNAME')
        if symbol(hstem'.FROMADDR') = "VAR" then from = from || ' <' || value(hstem'.FROMADDR') || '>'
        end
    else do
        from = head.FROMNAME
        if symbol('head.FROMADDR') = "VAR" then from = from || ' <' || head.FROMADDR || '>'
        end
    call writeln(of, 'From: 'from)

    if symbol(hstem'.TONAME') = "VAR" then do
        to = value(hstem'.TONAME')
        if symbol(hstem'.TOADDR') = "VAR" then to = to || ' <' || value(hstem'.TOADDR') || '>'
        call writeln(of, 'To: 'to)
        end

    if symbol(hstem'.SUBJECT') = 'VAR' then call writeln(of, 'Subject: 'value(hstem'.SUBJECT'))
    else call writeln(of, 'Subject: 'head.SUBJECT)

    if symbol(tstem'.COMMENT.COUNT') = "VAR" then do
        cnt = value(tstem'.COMMENT.COUNT')
        if cnt > 0 then do
            do i = 1 to cnt; call writeln(of, value(tstem'.COMMENT.'i)); end
            end
        end
    end

/*
** Write body text
*/

if symbol(tstem'.TEXT.COUNT') = "VAR" then do
    cnt = value(tstem'.TEXT.COUNT')
    if cnt > 0 then do
        call writeln(of, '')
        do i = 1 to cnt; call writeln(of, value(tstem'.TEXT.'i)); end
        end
    end

/*
** Check for message parts
*/

if symbol(tstem'.PART.COUNT') = "VAR" then do

    parts = value(tstem'.PART.COUNT')
    if parts > 0 then do i = 1 to parts
        select
            when symbol(tstem'.PART.'i'.BINARY') = "VAR" then do
                call writeln(of, '')

                cnt = 0
                if symbol(tstem'.PART.'i'.BINARY.COMMENT.COUNT') = VAR & header then cnt = value(tstem'.PART.'i'.BINARY.COMMENT.COUNT')
                if cnt > 0 then do
                    call writeln(of, '')
                    do j = 1 to cnt
                        call writeln(of, value(tstem'.PART.'i'.BINARY.COMMENT.'j))
                        end
                    end

                call writeln(of, '[Binary part: 'value(tstem'.PART.'i'.BINARY')']')

                if ~nobin then do
                    if exists(value(tstem'.PART.'i'.BINARY')) then do
                        address(command)
                        'Copy "'value(tstem'.PART.'i'.BINARY')'" TO "'downloadpath'" CLONE QUIET'
                        if rc ~= 0 then do
                            call displayerror(20, 'Save message', 'Failed to copy binary part to download directory.', msgno)
                            return(20)
                            end
                        address(bbsread)
                        call writeln(of, '[Binary part copied to: 'downloadpath']')
                        end
                    else call writeln(of, '[Binary part "'value(tstem'.PART.'i'.BINARY')'" was already deleted]')
                    end
                end

            when symbol(tstem'.PART.'i'.COMMENT.COUNT') = "VAR" & header then do
                cnt = value(tstem'.PART.'i'.COMMENT.COUNT')
                if cnt > 0 then do
                    do j = 1 to cnt
                        call writeln(of, value(tstem'.PART.'i'.COMMENT.'j))
                        end
                    end
                end

            when symbol(tstem'.PART.'i'.TEXT.COUNT') = "VAR" then do
                cnt = value(tstem'.PART.'i'.TEXT.COUNT')
                if cnt > 0 then do
                    call writeln(of, '')
                    do j = 1 to cnt
                        call writeln(of, value(tstem'.PART.'i'.TEXT.'j))
                        end
                    end
                end

            otherwise do
                call writeln(of, copies('=', 79))
                usestem = tstem'.PART.'i'.MSG'
                call savemsg(usestem, usestem, filename, filemode, header, nobin, msgno, downloadpath)
                end
            end
        end
    end

return(0)


 /****************************************************************************
************************** Write message to database **************************
 ****************************************************************************/

writemessage: interpret 'procedure expose 'globals
              parse arg wmarguments

/*
** Initialize arguments and parse them
*/

wmtemplate = 'SYSTEM/A,CONFERENCE/A,MSGSTEM/A,DONTMARKMESSAGE/S,REPLIED/S,PRIVATE/S,KEEP/S,READ/S,URGENT/S,IMPORTANT/S,CONFIDENTIAL/S,HAZELEVEL/K/N'

CDB_MARK_OWN_MSGS      = 22           /* Also mark messages from user when adding messages. */
CDF_NOT_ON_BBS         = '00008000'x  /* This conference is not on the bbs. */

wmargs.DONTMARKMESSAGE = 0; wmargs.PRIVATE      = 0; wmargs.READ = 0;    wmargs.URGENT  = 0
wmargs.IMPORTANT       = 0; wmargs.CONFIDENTIAL = 0; wmargs.KEEP = 0;    wmargs.REPLIED = 0
wmargs.HAZELEVEL       = 0

address(bbsread)
'READARGS 'wmtemplate wmargs' CMDLINE 'wmarguments
if rc ~= 0 then do
    call displayerror(10, 'Write message', 'READARGS: 'BBSREAD.LASTERROR)
    return(10)
    end

/*
** See if the conference the msg will be written to exists
*/

if conflist.system ~= wmargs.SYSTEM then do
    'GETCONFLIST BBSNAME "'wmargs.SYSTEM'" STEM 'conflist
    if rc ~= 0 then call displayerror(30, 'SortMail', 'GETCONFLIST: 'BBSREAD.LASTERROR)
    conflist.system = wmargs.SYSTEM
    end

do n = 1 to conflist.COUNT + 1 while upper(wmargs.CONFERENCE) ~= upper(conflist.n)
    if n = conflist.COUNT + 1 then do
        /* Create the new conference */
        'CONFIGCONF "'wmargs.SYSTEM'" "'wmargs.CONFERENCE'" SET 'c2x(CDF_NOT_ON_BBS)
        if rc ~= 0 then do
            call displayerror(30, 'Write message', 'CONFIGCONF: 'BBSREAD.LASTERROR)
            return(30)
            end
        conflist.n = toconf
        conflist.COUNT = conflist.COUNT + 1
        end
    end

/*
** If Show own messages isn't activated in conference mark then don't
** mark message as unread.
*/

'GETCONFDATA "'wmargs.SYSTEM'" "'wmargs.CONFERENCE'" STEM 'confdata
if rc ~= 0 then do
    returned = rc
    call displayerror(returned, 'Write message', 'GETCONFDATA: 'BBSREAD.LASTERROR)
    return(returned)
    end

if ~bittst(confdata.FLAGS, CDB_MARK_OWN_MSGS) & (value(wmargs.msgstem'.fromaddr') = bbsdata.EMAILADDR) then wmargs.DONTMARKMESSAGE = 1

/*
** Set the selected message flags
*/

writeflags = ''
if wmargs.DONTMARKMESSAGE then writeflags = writeflags'DONTMARKMESSAGE '
if wmargs.PRIVATE         then writeflags = writeflags'PRIVATE '
if wmargs.READ            then writeflags = writeflags'READ '
if wmargs.URGENT          then writeflags = writeflags'URGENT '
if wmargs.IMPORTANT       then writeflags = writeflags'IMPORTANT '
if wmargs.CONFIDENTIAL    then writeflags = writeflags'CONFIDENTIAL '

updateflags = ''
if wmargs.KEEP            then updateflags = updateflags'SETKEEP '
if wmargs.REPLIED         then updateflags = updateflags'SETREPLIED '
if wmargs.HAZELEVEL > 0   then updateflags = updateflags'HAZELEVEL 'wmargs.HAZELEVEL' '

/*
** Write the message
*/

address(bbsread)
'WRITEBRMESSAGE "'wmargs.SYSTEM'" "'wmargs.CONFERENCE'" STEM 'wmargs.MSGSTEM
msgnr = result

if rc ~= 0 then do
    returned = rc
    call displayerror(returned, 'Write message', 'WRITEBRMESSAGE: 'BBSREAD.LASTERROR)
    return(returned)
    end

/*
** Give the new message it's flags
*/

if updateflags ~= '' then do
    'UPDATEBRMESSAGE "'wmargs.SYSTEM'" "'wmargs.CONFERENCE'" 'msgnr updateflags
    if rc ~= 0 then do
        returned = rc
        call displayerror(returned, 'Write message', 'UPDATEBRMESSAGE: 'BBSREAD.LASTERROR, msgnr)
        return(returned)
        end
    end

return(0)


 /****************************************************************************
*********************** Open and read configuration file **********************
 ****************************************************************************/

readcfg: interpret 'procedure expose 'globals

triggers = 0

address(bbsread)

cfgopen = open(cf, bbsdata.BBSPATH || cfgfile, 'R')

if cfgopen then do
    cfglength = seek(cf, 0, 'E'); call seek(cf, 0, 'B')

    cfgline = 0

    do until (seek(cf, 0) = cfglength)
        entry = readln(cf); cfgline = cfgline + 1

        if symbol('progwin') = 'VAR' then do
            address(thorport)
            'UPDATEPROGRESS 'progwin' CURRENT 'seek(cf, 0)' TOTAL 'cfglength
            if rc = 5 then signal cleanup
            if rc ~= 0 then displayerror(rc, 'Read config', 'UPDATEPROGRESS: 'THOR.LASTERROR)
            address(bbsread)
            end

        select
            when upper(subword(entry, 1, 1)) = "SYSTEM" then displayerror(30, 'Read config', 'Found old 2.x configuration file.  SortMail has\nchanged the configuration file format in version\n3.0.  Please create a new one with CfgSortMail.thor.')

            when upper(subword(entry, 1, 1)) = "GLOBAL" then do
                globalcfg.STATISTICS = 0; globalcfg.NOWARN = 0; globalcfg.LOGINSTATE = 0
                'READARGS TEMPLATE "SYSTEM/K,CONFERENCE/A,STATISTICS/S,NOWARN/S,LOGINSTATE/S" STEM 'globalcfg' CMDLINE 'subword(entry, 2)
                if rc ~= 0 then call displayerror(30, 'Read config', 'Error in 'cfgfile' line 'cfgline': 'BBSREAD.LASTERROR)

                /*
                ** Exit of user's in the wrong system or there's no marked msgs
                */

                if fromthor then do
                    globalcfg.SYSTEM = cursys.BBSNAME
                    'GETCONFDATA "'globalcfg.SYSTEM'" "'globalcfg.CONFERENCE'" STEM 'confdata
                    if rc ~= 0 then call displayerror(30, 'SortMail', 'GETCONFDATA: 'BBSREAD.LASTERROR)
                    if confdata.MSGMARKED = 0 then signal cleanup
                    end
                end

            when upper(subword(entry, 1, 1)) = "TRIGGER" then do
                triggers = triggers + 1
                trigger.triggers.cmdline = subword(entry, 2)
                trigger.triggers.DELMSG = 0; trigger.triggers.DELUSER = 0; trigger.triggers.MATCHALL = 0; trigger.triggers.hitcount = 0; trigger.triggers.failcount = 0
                'READARGS TEMPLATE "NAME/A,DELMSG/S,DELUSER/S,MATCHALL/S" STEM 'trigger.triggers' CMDLINE 'trigger.triggers.cmdline
                if rc ~= 0 then call displayerror(30, 'Read config', 'Error in 'cfgfile' line 'cfgline': 'BBSREAD.LASTERROR)

                do
                    searches = 0; actions = 0

                    do until (upper(subentry) = 'ENDTRIGGER') | (eof(cf))
                        subentry = readln(cf); cfgline = cfgline + 1

                        select
                            when upper(subword(subentry, 1, 1)) = 'ACTION' then do
                                actions = actions + 1
                                trigger.triggers.action.actions.checkdupes = 0; trigger.triggers.action.actions.dontadd = 0; trigger.triggers.action.actions.nostats = 0; trigger.triggers.action.actions.header = 0; trigger.triggers.action.actions.append = 0; trigger.triggers.action.actions.nobin = 0; trigger.triggers.action.actions.hitcount = 0; trigger.triggers.action.actions.failcount = 0
                                'READARGS TEMPLATE "TYPE/A,DESTSYS/K,DESTCONF/K,REPLYADDR/K,SCRIPTNAME/K,SCRIPTOPTS/K,FILENAME/K,DIRECTORY/K,SUBSTITUTE/K,WITH/K,HEADER/S,APPEND/S,NOBIN/S,CHECKDUPES/S,DONTADD/S,NOSTATS/S" STEM 'trigger.triggers.action.actions' CMDLINE 'subword(subentry, 2)
                                trigger.triggers.action.actions.type = upper(trigger.triggers.action.actions.type)
                                if rc ~= 0 then call displayerror(30, 'Read config', 'Error in 'cfgfile' line 'cfgline': 'BBSREAD.LASTERROR)
                                end

                            when upper(subword(subentry, 1, 1)) = 'SEARCH' then do
                                searches = searches + 1
                                'READARGS TEMPLATE "TYPE/A,CRITERIA/A,KEYWORD/K" STEM 'trigger.triggers.search.searches' CMDLINE 'subword(subentry, 2)
                                trigger.triggers.search.searches.type = upper(trigger.triggers.search.searches.type)
                                if rc ~= 0 then call displayerror(30, 'Read config', 'Error in 'cfgfile' line 'cfgline': 'BBSREAD.LASTERROR)
                                end

                            when eof(cf) then call displayerror(30, 'Read config', 'Premature end of configuration file 'cfgfile)

                            when upper(subword(subentry, 1, 1)) = 'TRIGGER' then call displayerror(30, 'Read config', 'TRIGGER did not contain ENDTRIGGER in 'cfgfile' line 'cfgline)

                            otherwise nop
                            end
                        end
                    end

                trigger.triggers.action.count = actions
                trigger.triggers.search.count = searches
                end

            otherwise nop
            end

        trigger.count = triggers
        end
    end
else do
    call displayerror(30, 'Read config', 'Couldn''t open ' || bbsdata.BBSPATH || cfgfile || ' for reading.')
    end

if trigger.count = 0 then signal cleanup

call close(cf)

return(0)


 /****************************************************************************
*********************** Display requester / type message **********************
 ****************************************************************************/

notify: interpret 'procedure expose 'globals
        parse arg message, choices

seperator = index(choices, '|')
if seperator > 0 then do
    firstchoice = substr(choices, 1, seperator - 1)
    secondchoice = substr(choices, seperator + 1)
    end

address(bbsread)
'BUFMODE ENDCOPYBACK'

if ~fromthor then do
    message = substitute(message, '\n', ' ')

    if seperator > 0 then do
        say message
        options prompt firstchoice' or 'secondchoice': '
        parse pull choice
        options prompt

        select
            when upper(left(choice, 1)) = upper(left(firstchoice, 1)) then reqres = 1
            when upper(left(choice, 1)) = upper(left(secondchoice, 1)) then reqres = 0
            otherwise reqres = 0
            end
        say
        end
    else do
        say message
        say
        reqres = 0
        end
    end
else do
    message = substitute(message, '"', '*"')
    address(thorport)
    REQUESTNOTIFY '"'message'"' '"'choices'"'
    reqres = result
    end

address(bbsread)
'BUFMODE COPYBACK'

return(reqres)


 /****************************************************************************
*********************** Display error and return or quit **********************
 ****************************************************************************/

displayerror: interpret 'procedure expose 'globals
              parse arg returned, caller, errmsg, msgno

if msgno ~= '' then errhead = caller' returned 'returned' on message #'msgno':'
else errhead = caller' returned 'returned' in line 'sigl':'

select
    when returned > 0 & returned < 6 then do
        if ~globalcfg.NOWARN then do
            call notify(errhead || '\n' || errmsg, 'Continue|Abort')
            if result = 0 then signal cleanup
            end

        errlogcount = errlogcount + 1; errlog.text.errlogcount = errhead
        errlogcount = errlogcount + 1; errlog.text.errlogcount = errmsg
        errlogcount = errlogcount + 1; errlog.text.errlogcount = ''
        end

    when returned > 5 & returned < 20 then do
        call notify(errhead || '\n' || errmsg, 'Continue|Abort')
        if result = 0 then signal cleanup

        errlogcount = errlogcount + 1; errlog.text.errlogcount = errhead
        errlogcount = errlogcount + 1; errlog.text.errlogcount = errmsg
        errlogcount = errlogcount + 1; errlog.text.errlogcount = ''
        end

    when returned > 19 then do
        call notify(errhead || '\n' || errmsg, 'Abort')
        signal cleanup
        end

    otherwise nop
    end

drop THOR.LASTERROR BBSREAD.LASTERROR

return(0)


 /****************************************************************************
********************* Substitute a string within a string *********************
******** Shamelessly ripped from Troels Walsted Hansen's UUDecode.thor ********
 ****************************************************************************/

substitute: interpret 'procedure expose 'globals
            parse arg str, org, new

lastfound = 0

found = index(str, org)

do while found > lastfound
    secondpart = substr(str, found + length(org))
    firstpart = substr(str, 1, length(str) - length(substr(str, found)))
    str = firstpart || new || secondpart
    lastfound = found + length(new)
    found = index(str, org, lastfound)
    end

return(str)


 /****************************************************************************
******************************** Split digests ********************************
 ****************************************************************************/

splitdigest: interpret 'procedure expose 'globals
             parse arg msgno, destconf, repaddr, tosys, mailconf

/*
** Read message's header and text stems
*/

if textread = 0 then do
    'READBRMESSAGE "'globalcfg.SYSTEM'" "'globalcfg.CONFERENCE'" 'msgno' TEXTSTEM 'text
    if rc ~= 0 then do
        call displayerror(10, 'Split digest', 'READBRMESSAGE, text stem: 'BBSREAD.LASTERROR, msgno)
        return(10)
        end
    end

if symbol('text.TEXT.COUNT') = 'VAR' & text.TEXT.COUNT > 0 & symbol('text.PART.COUNT') = 'VAR' & text.PART.COUNT > 0 then do
    call displayerror(5, 'Split digest', 'Message contains both a text body and text parts.', msgno)
    return(5)
    end

if symbol('text.PART.COUNT') = 'VAR' & text.PART.COUNT > 0 then do
    returned = 0
    do i = 1 to text.PART.COUNT
        if (symbol('text.PART.'i'.TEXT.COUNT') = 'VAR' | symbol('text.PART.'i'.COMMENT.COUNT') = 'VAR' | symbol('text.PART.'i'.BINARY') = 'VAR') & (returned ~= 5) then do
            call displayerror(5, 'Split digest', 'MIME digest contains a non-text part.', msgno)
            returned = 5
            end
        if symbol('text.PART.'i'.MSG.FROMNAME')        ~= 'VAR' then text.PART.i.MSG.fromname          = head.FROMNAME
        if symbol('text.PART.'i'.MSG.FROMADDR')        ~= 'VAR' then text.PART.i.MSG.fromaddr          = head.FROMADDR
        if symbol('text.PART.'i'.MSG.TONAME')          ~= 'VAR' then text.PART.i.MSG.toname            = head.TONAME
        if symbol('text.PART.'i'.MSG.TOADDR')          ~= 'VAR' then text.PART.i.MSG.toaddr            = head.TOADDR
        /*    if symbol('text.PART.'i'.MSG.MSGID')           ~= 'VAR' then text.PART.i.MSG.msgid             = head.MSGID*/
        if symbol('text.PART.'i'.MSG.REFID')           ~= 'VAR' then text.PART.i.MSG.refid             = head.REFID
        if symbol('text.PART.'i'.MSG.CREATIONDATE')    ~= 'VAR' then text.PART.i.MSG.creationdate      = head.CREATIONDATE
        if symbol('text.PART.'i'.MSG.CREATIONDATETXT') ~= 'VAR' then text.PART.i.MSG.creationdatetxt   = head.CREATIONDATETXT
        if symbol('text.PART.'i'.MSG.SUBJECT')         ~= 'VAR' then text.PART.i.MSG.subject           = head.SUBJECT

        if (repaddr = '') | (right(repaddr, 9) = 'REPLYADDR') then do
            if symbol('text.replyaddr') = 'VAR' then do
                text.PART.i.MSG.replyaddr = text.replyaddr
                if symbol('text.replyname') = 'VAR' then text.PART.i.MSG.replyname = text.replyname
                end
            else do
                text.PART.i.MSG.replyaddr = head.fromaddr
                if symbol('head.fromname') = 'VAR' then text.PART.i.MSG.replyname = head.fromname
                end
            end
        else text.PART.i.MSG.replyaddr = repaddr

        text.PART.i.MSG.replyconf = mailconf

        if (tosys = '') | (right(tosys, 7) = 'DESTSYS') then call writemessage(SYSTEM '"'globalcfg.SYSTEM'"' CONFERENCE '"'destconf'"' MSGSTEM value(text.PART.'i'.MSG))
        else call writemessage(SYSTEM '"'tosys'"' CONFERENCE '"'destconf'"' MSGSTEM value(text.PART.'i'.MSG))

        if result ~= 0 then do
            if (returned > 0) & (returned > result) then return(returned)
            else return(result)
            end
        end
    end
else do
    line = 1; parsed = 0; drop endsubmsg

    do forever
        newmsg.text.count = 0

        fromline = 0; subjline = 0; dateline = 0; msgoffset = 0

        do until (text.text.line = '') & (fromline ~= 0)
            select
                when upper(subword(text.text.line, 1, 1)) = "FROM:" then fromline = line
                when upper(subword(text.text.line, 1, 1)) = "SUBJECT:" then subjline = line
                when upper(subword(text.text.line, 1, 1)) = "DATE:" then dateline = line
                when msgoffset > 100 then do
                    call displayerror(5, 'Parse digest', 'Couldn''t find sub-message, no from: line.', msgno)
                    return(5)
                    end
                when line > text.text.count then do
                    if ~parsed then do
                        call displayerror(5, 'Parse digest', 'Unexpected end of message.', msgno)
                        return(5)
                        end
                    else return(0)
                    end
                otherwise nop
                end

            line = line + 1; msgoffset = msgoffset + 1
            end

        /* Pick up date line and skip blank lines */

        do forever
            if line = text.text.count then do
                call displayerror(5, 'Parse digest', 'Failed to find start of first submessage''s text body.', msgno)
                return(5)
                end
            if upper(subword(text.text.line, 1, 1)) = "DATE:" then dateline = line
            else if text.text.line ~= '' then break
            line = line + 1
            end

        /* Search for 'End of message' line or the end of the digest */

        newmsg.text.count = 0; msgline = 0; foundend = 0
        do forever
            notthisone = 0

            if line = text.text.count then do
                call displayerror(5, 'Parse digest', 'Immature end of message.', msgno)
                return(5)
                end

            if (symbol('endsubmsg') ~= 'VAR') & (upper(subword(text.text.line, 1, 1)) = "FROM:") then do
                call displayerror(5, 'Parse digest', 'End of submessage not detected.', msgno)
                return(5)
                end

            if symbol('endsubmsg') ~= 'VAR' then do
                if (left(text.text.line, 1) = '-') & (length(text.text.line) > 29) & (length(text.text.line) = length(compress(text.text.line))) & (text.text.line = copies(left(text.text.line, 1), length(text.text.line))) then do
                    templine = line + 1
                    do until (foundend) | (notthisone) | (templine = text.text.count)
                        if (text.text.templine ~= '') then do
                            if (upper(subword(text.text.templine, 1, 1)) = "FROM:") | (upper(subword(text.text.templine, 1, 1)) = "DATE:") | (upper(subword(text.text.templine, 1, 1)) = "SUBJECT:") | (upper(left(text.text.templine, 9)) = 'MESSAGE #') then do
                                endsubmsg = text.text.line; foundend = 1
                                end
                            else if ((templine + 7) <= text.text.COUNT) then notthisone = 1; else foundend = 1
                            end
                        templine = templine + 1
                        end
                    end
                end
            else if compare(endsubmsg, text.text.line) = 0 then foundend = 1

            if foundend then break

            msgline = msgline + 1; newmsg.text.msgline = text.text.line
            newmsg.text.count = newmsg.text.count + 1
            line = line + 1
            end

        /* Some magic to find name, address and subject */

        newmsg.subject = "<no subject>"
        newmsg.fromname = "Unknown"
        newmsg.fromaddr = "<no address>"

        from = strip(substr(text.text.fromline, 6))
        from = translate(from, '<>', '()')
        i = pos("<", from)

        if (i ~= 0) & (pos(">", from) > 0) then do
            checkaddr = strip(substr(from, i, pos('>', from) - i), B, ' <>"')
            if pos("@", checkaddr) = 0 then do
                newmsg.fromname = checkaddr
                newmsg.fromaddr = strip(delstr(from, i, pos('>', from) - i), B, ' >')
                end
            else do
                newmsg.fromaddr = checkaddr
                newmsg.fromname = strip(delstr(from, i, pos('>', from) - i), B, ' ">')
                end
            end
        else do
            if pos("@", from) = 0 then do
                newmsg.fromname = strip(from, B, ' <>"')
                end
            else do
                newmsg.fromaddr = strip(from, B, ' <>"')
                end
            end

        if subjline ~= 0 then newmsg.subject = strip(subword(text.text.subjline, 2))
        if dateline ~= 0 then newmsg.creationdatetxt = strip(subword(text.text.dateline, 2))

        /* Removed msgid copying to avoid multiple messages with the same message id
        if symbol('head.MSGID')           ~= 'VAR' then newmsg.msgid             = head.MSGID
        */

        /* Find correct reply address */

        if (repaddr = '') | (right(repaddr, 9) = 'REPLYADDR') then do
            if symbol('text.replyaddr') = 'VAR' then do
                newmsg.replyaddr = text.replyaddr
                if symbol('text.replyname') = 'VAR' then newmsg.replyname = text.replyname
                end
            else do
                newmsg.replyaddr = head.fromaddr
                if symbol('head.fromname') = 'VAR' then newmsg.replyname = head.fromname
                end
            end
        else newmsg.replyaddr = repaddr

        newmsg.replyconf = mailconf

        if (tosys = '') | (right(tosys, 7) = 'DESTSYS') then call writemessage(SYSTEM '"'globalcfg.SYSTEM'"' CONFERENCE '"'destconf'"' MSGSTEM newmsg)
        else call writemessage(SYSTEM '"'tosys'"' CONFERENCE '"'destconf'"' MSGSTEM newmsg)

        if result ~= 0 then return(result)
        drop newmsg.; parsed = 1
        end
    end

return(0)


 /****************************************************************************
****************************** Check Thor version *****************************
 ****************************************************************************/

getver: interpret 'procedure expose 'globals

address(thorport)
'VERSION STEM 'ver

fullver = subword(ver.THOR, 1, 1)
ver.thorver = substr(fullver, 1, index(fullver, '.') - 1)
ver.thorrev = compress(substr(fullver, index(fullver, '.') + 1), 'ß')
ver.thorrev = ver.thorrev

/* Circumvent a bug in Thor 2.31 that appends garbage to ver.THOR */

if left(ver.thorrev, 2) = 31 then ver.thorrev = 31

return(0)